home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v10n01.arc
/
MAKECLIP.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-12-11
|
2KB
|
83 lines
10 ' MAKECLIP.BAS Clipper Version
20 ' Generate a procedure to recreate a .DBF or other file
100 CLS
110 ALPHA$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVW"
115 ALPHA$ = ALPHA$ + "XYZ1234567890`~-_=+;:<>,.?/|\!@#$%^&*()"
120 LINE INPUT "dBASE file to read :", S$
130 IF INSTR(S$, ".") = 0 THEN S$ = S$ + ".dbf"
140 ON ERROR GOTO 740
150 OPEN S$ FOR INPUT AS #1
160 CLOSE 1: ON ERROR GOTO 0
170 LINE INPUT "Procedure file to append to :", T$
172 IF T$ = "" THEN 170
180 IF INSTR(T$, ".") = 0 THEN T$ = T$ + ".prg"
190 LINE INPUT "Procedure name :", P$: IF P$ = "" THEN 190
200 OPEN S$ FOR RANDOM AS #1 LEN = 1
210 FIELD 1, 1 AS A$: FL = LOF(1)
220 GET 1, FL: IF A$ = CHR$(26) THEN FL = FL - 1
230 OPEN T$ FOR APPEND AS #2
240 PRINT #2, "PROCEDURE "; P$
250 PRINT #2, "PARAMETER F_TMP"
260 PRINT #2, "NL=CHR(0)"
270 PRINT #2, "IF PCOUNT()=0"
280 PRINT #2, " SET ALTERNATE TO "; S$
290 PRINT #2, "ELSE"
300 PRINT #2, " SET ALTE TO &F_TMP"
310 PRINT #2, "ENDIF"
320 PRINT #2, "SET ALTERNATE ON"
330 PRINT #2, "SET CONSOLE OFF"
340 PRINT #2, "?? ";
350 LC = 0
360 FOR Y = 1 TO FL
370 GET 1, Y
380 LC = LC + 1
390 IF A$ <> CHR$(0) THEN 490
395 IF Y = FL THEN GOTO 650
400 NLCNT = 0
410 WHILE A$ = CHR$(0)
420 NLCNT = NLCNT + 1
430 Y = Y + 1
440 GET 1, Y
445 IF Y = FL THEN GOTO 460
450 WEND
460 Y = Y - 1
470 IF NLCNT = 1 THEN PRINT #2, "NL"; : GOTO 660
480 PRINT #2, "REPL(NL," + MID$(STR$(NLCNT), 2) + ")"; : GOTO 660
490 IF INSTR(ALPHA$, A$) = 0 THEN 650
500 PRINT #2, CHR$(34);
510 QCNT = 0
520 WHILE INSTR(ALPHA$, A$) <> 0 AND Y <= FL
530 QCNT = QCNT + 1
540 IF QCNT > 50 THEN GOSUB 810
550 PRINT #2, A$;
560 Y = Y + 1
570 GET 1, Y
580 WEND
590 Y = Y - 1
600 PRINT #2, CHR$(34);
610 IF Y >= FL THEN 670
620 LC = LC + INT(QCNT / 10)
630 IF LC > 7 THEN LC = 7
640 GOTO 660
650 PRINT #2, "CHR("; MID$(STR$(ASC(A$)), 2); ")";
660 IF LC >= 7 THEN GOSUB 910 ELSE IF Y <> FL THEN PRINT #2, "+";
670 NEXT
680 PRINT #2,
690 PRINT #2, "SET ALTERNATE OFF"
700 PRINT #2, "SET ALTERNATE TO"
710 PRINT #2, "SET CONSOLE ON"
715 PRINT #2, "RETURN"
720 CLOSE 1, 2
730 END
740 PRINT : PRINT "Invalid filename."
750 RESUME 120
800 '
810 PRINT #2, CHR$(34): PRINT #2, "?? "; CHR$(34);
820 LC = 1: QCNT = 1
830 RETURN
900 '
910 IF Y = FL THEN RETURN
920 PRINT #2, : PRINT #2, "?? "; : LC = 0
930 RETURN